home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / w3 / w3-hot.el.z / w3-hot.el
Encoding:
Text File  |  1998-05-21  |  12.7 KB  |  371 lines
  1. ;;; w3-hot.el --- Main functions for emacs-w3 on all platforms/versions
  2. ;; Author: wmperry
  3. ;; Created: 1998/01/06 14:20:19
  4. ;; Version: 1.20
  5. ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu>
  9. ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
  10. ;;;
  11. ;;; This file is part of GNU Emacs.
  12. ;;;
  13. ;;; GNU Emacs is free software; you can redistribute it and/or modify
  14. ;;; it under the terms of the GNU General Public License as published by
  15. ;;; the Free Software Foundation; either version 2, or (at your option)
  16. ;;; any later version.
  17. ;;;
  18. ;;; GNU Emacs is distributed in the hope that it will be useful,
  19. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21. ;;; GNU General Public License for more details.
  22. ;;;
  23. ;;; You should have received a copy of the GNU General Public License
  24. ;;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25. ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26. ;;; Boston, MA 02111-1307, USA.
  27. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28.  
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30. ;;; Structure for hotlists
  31. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32. ;;; (
  33. ;;;  ("name of item1" . "http://foo.bar.com/")    ;; A single item in hotlist
  34. ;;;  ("name of item2" . (                         ;; A sublist
  35. ;;;                      ("name of item3" . "http://www.ack.com/")
  36. ;;;                     ))
  37. ;;; )  ; end of hotlist
  38. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  39. (require 'w3-vars)
  40.  
  41. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  42. ;;; Hotlist Handling Code
  43. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  44. (defvar w3-html-bookmarks nil)
  45.  
  46. (defun w3-hotlist-break-shit ()
  47.   (let ((todo '(w3-hotlist-apropos
  48.         w3-hotlist-delete
  49.         w3-hotlist-rename-entry
  50.         w3-hotlist-append
  51.         w3-use-hotlist
  52.         w3-hotlist-add-document
  53.         w3-hotlist-add-document-at-point
  54.         ))
  55.     (cur nil))
  56.     (while todo
  57.       (setq cur (car todo)
  58.         todo (cdr todo))
  59.       (fset cur
  60.         (`
  61.          (lambda (&rest ignore)
  62.            (error "Sorry, `%s' does not work with html bookmarks"
  63.               (quote (, cur)))))))))
  64.  
  65. ;;;###autoload
  66. (defun w3-read-html-bookmarks (fname)
  67.   "Import an HTML file into the Emacs-w3 format."
  68.   (interactive "fBookmark file: ")
  69.   (if (not (file-readable-p fname))
  70.       (error "Can not read %s..." fname))
  71.   (save-excursion
  72.     (set-buffer (get-buffer-create " *bookmark-work*"))
  73.     (erase-buffer)
  74.     (insert-file-contents fname)
  75.     (let* ((w3-debug-html nil)
  76.        (bkmarks nil)
  77.        (parse (w3-parse-buffer (current-buffer))))
  78.       (setq parse w3-last-parse-tree
  79.         bkmarks (nreverse (w3-grok-html-bookmarks parse))
  80.         w3-html-bookmarks bkmarks)))
  81.   (w3-hotlist-break-shit))
  82.  
  83. (eval-when-compile
  84.   (defvar cur-stack nil)
  85.   (defvar cur-title nil)
  86.   (defmacro push-new-menu ()
  87.     '(setq cur-stack (cons (list "") cur-stack)))
  88.   
  89.   (defmacro push-new-item (title href)
  90.     (` (setcar cur-stack (cons (vector (, title) (list 'w3-fetch (, href)) t)
  91.                    (car cur-stack)))))
  92.   ;;(` (setcar cur-stack (cons (cons (, title) (, href)) (car cur-stack)))))
  93.   
  94.   (defmacro finish-submenu ()
  95.     '(let ((x (nreverse (car cur-stack))))
  96.        (and x (setcar x (car cur-title)))
  97.        (setq cur-stack (cdr cur-stack)
  98.          cur-title (cdr cur-title))
  99.        (if cur-stack
  100.        (setcar cur-stack (cons x (car cur-stack)))
  101.      (setq cur-stack (list x)))))
  102.   )
  103.     
  104. (defun w3-grok-html-bookmarks-internal (tree)
  105.   (let (node tag content args)
  106.     (while tree
  107.       (setq node (car tree)
  108.         tree (cdr tree)
  109.         tag (and (listp node) (nth 0 node))
  110.         args (and (listp node) (nth 1 node))
  111.         content (and (listp node) (nth 2 node)))
  112.       (cond
  113.        ((eq tag 'title)
  114.     (setq cur-title (list (w3-normalize-spaces (car content))))
  115.     (w3-grok-html-bookmarks-internal content))
  116.        ((memq tag '(dl ol ul))
  117.     (push-new-menu)
  118.     (w3-grok-html-bookmarks-internal content)
  119.     (finish-submenu))
  120.        ((and (memq tag '(dt li p))
  121.          (stringp (car content)))
  122.     (setq cur-title (cons (w3-normalize-spaces (car content))
  123.                   cur-title)))
  124.        ((and (eq tag 'a)
  125.          (stringp (car-safe content))
  126.          (cdr-safe (assq 'href args)))
  127.     (push-new-item (w3-normalize-spaces (car-safe content))
  128.                (cdr-safe (assq 'href args))))
  129.        (content
  130.     (w3-grok-html-bookmarks-internal content))))))
  131.     
  132. (defun w3-grok-html-bookmarks (chunk)
  133.   (let (
  134.     cur-title
  135.     cur-stack
  136.     )
  137.     (w3-grok-html-bookmarks-internal chunk)
  138.     (reverse (car cur-stack))))
  139.  
  140. ;;;###autoload
  141. (defun w3-hotlist-apropos (regexp)
  142.   "Show hotlist entries matching REGEXP."
  143.   (interactive "sW3 Hotlist Apropos (regexp): ")
  144.   (or w3-setup-done (w3-do-setup))
  145.   (let ((save-buf (get-buffer "Hotlist")) ; avoid killing this
  146.     (w3-hotlist
  147.      (apply
  148.       'nconc
  149.       (mapcar
  150.        (function
  151.         (lambda (entry)
  152.           (if (or (string-match regexp (car entry))
  153.               (string-match regexp (car (cdr entry))))
  154.           (list entry))))
  155.        w3-hotlist))))
  156.     (if (not w3-hotlist)
  157.     (message "No w3-hotlist entries match \"%s\"" regexp)
  158.       (and save-buf (save-excursion
  159.               (set-buffer save-buf)
  160.               (rename-buffer (concat "Hotlist during " regexp))))
  161.       (unwind-protect
  162.       (let ((w3-reuse-buffers 'no))
  163.         (w3-show-hotlist)
  164.         (rename-buffer (concat "Hotlist \"" regexp "\""))
  165.         (url-set-filename url-current-object (concat "hotlist/" regexp)))
  166.     (and save-buf (save-excursion
  167.             (set-buffer save-buf)
  168.             (rename-buffer "Hotlist")))))))
  169.  
  170. ;;;###autoload
  171. (defun w3-hotlist-refresh ()
  172.   "Reload the default hotlist file into memory"
  173.   (interactive)
  174.   (if (not w3-setup-done) (w3-do-setup))
  175.   (w3-parse-hotlist))
  176.  
  177. (defun w3-delete-from-alist (x alist)
  178.   ;; Remove X from ALIST, return new alist
  179.   (if (eq (assoc x alist) (car alist)) (cdr alist)
  180.     (delq (assoc x alist) alist)))
  181.  
  182. ;;;###autoload
  183. (defun w3-hotlist-delete ()
  184.   "Deletes a document from your hotlist file"
  185.   (interactive)
  186.   (save-excursion
  187.     (if (not w3-hotlist) (message "No hotlist in memory!")
  188.       (if (not (file-exists-p w3-hotlist-file))
  189.       (message "Hotlist file %s does not exist." w3-hotlist-file)
  190.     (let* ((completion-ignore-case t)
  191.            (title (car (assoc (completing-read "Delete Document: "
  192.                            w3-hotlist nil t)
  193.                   w3-hotlist)))
  194.            (case-fold-search nil)
  195.            (buffer (get-buffer-create " *HOTW3*")))
  196.       (and (string= title "") (error "No document specified."))
  197.       (set-buffer buffer)
  198.       (erase-buffer)
  199.       (insert-file-contents w3-hotlist-file)
  200.       (goto-char (point-min))
  201.       (if (re-search-forward (concat "^" (regexp-quote title) "\r*$")
  202.                  nil t)
  203.           (let ((make-backup-files nil)
  204.             (version-control nil)
  205.             (require-final-newline t))
  206.         (previous-line 1)
  207.         (beginning-of-line)
  208.         (delete-region (point) (progn (forward-line 2) (point)))
  209.         (write-file w3-hotlist-file)
  210.         (setq w3-hotlist (w3-delete-from-alist title w3-hotlist))
  211.         (kill-buffer (current-buffer)))
  212.         (message "%s was not found in %s" title w3-hotlist-file)))))))
  213.  
  214. ;;;###autoload
  215. (defun w3-hotlist-rename-entry (title)
  216.   "Rename a hotlist item"
  217.   (interactive (list (let ((completion-ignore-case t))
  218.                (completing-read "Rename entry: " w3-hotlist nil t))))
  219.   (cond                    ; Do the error handling first
  220.    ((string= title "") (error "No document specified!"))
  221.    ((not w3-hotlist) (error "No hotlist in memory!"))
  222.    ((not (file-exists-p (expand-file-name w3-hotlist-file)))
  223.     (error "Hotlist file %s does not exist." w3-hotlist-file))
  224.    ((not (file-readable-p (expand-file-name w3-hotlist-file)))
  225.     (error "Hotlist file %s exists, but is unreadable." w3-hotlist-file)))
  226.   (save-excursion
  227.     (let ((obj (assoc title w3-hotlist))
  228.       (used (mapcar 'car w3-hotlist))
  229.       (buff (get-buffer-create " *HOTW3*"))
  230.       (new nil)
  231.       )
  232.       (while (or (null new) (member new used))
  233.     (setq new (read-string "New name: ")))
  234.       (set-buffer buff)
  235.       (erase-buffer)
  236.       (insert-file-contents (expand-file-name w3-hotlist-file))
  237.       (goto-char (point-min))
  238.       (if (re-search-forward (regexp-quote title) nil t)
  239.       (let ((make-backup-files nil)
  240.         (version-control nil)
  241.         (require-final-newline t))
  242.         (previous-line 1)
  243.         (beginning-of-line)
  244.         (delete-region (point) (progn (forward-line 2) (point)))
  245.         (insert (format "%s %s\n%s\n" (nth 1 obj) (current-time-string)
  246.                 new))
  247.         (setq w3-hotlist (cons (list new (nth 1 obj))
  248.                    (w3-delete-from-alist title w3-hotlist)))
  249.         (write-file w3-hotlist-file)
  250.         (kill-buffer (current-buffer))
  251.         (if (not w3-running-xemacs)
  252.         (progn
  253.           (delete-menu-item '("Go"))
  254.           (w3-build-FSF19-menu))))
  255.     (message "%s was not found in %s" title w3-hotlist-file)))))
  256.  
  257. ;;;###autoload
  258. (defun w3-hotlist-append (fname)
  259.   "Append a hotlist to the one in memory"
  260.   (interactive "fAppend hotlist file: ")
  261.   (let ((x w3-hotlist))
  262.     (w3-parse-hotlist fname)
  263.     (setq w3-hotlist (nconc x w3-hotlist))))
  264.  
  265. (defun w3-hotlist-parse-old-mosaic-format ()
  266.   (let (cur-link cur-alias)
  267.     (while (re-search-forward "^\n" nil t) (replace-match ""))
  268.     (goto-line 3)
  269.     (while (not (eobp))
  270.       (re-search-forward "^[^ ]*" nil t)
  271.       (setq cur-link (buffer-substring (match-beginning 0) (match-end 0)))
  272.       (setq cur-alias (buffer-substring (progn
  273.                       (forward-line 1)
  274.                       (beginning-of-line)
  275.                       (point))
  276.                     (progn
  277.                       (end-of-line)
  278.                       (point))))
  279.       (if (not (equal cur-alias ""))
  280.       (setq w3-hotlist (cons (list cur-alias cur-link) w3-hotlist))))))
  281.  
  282. ;;;###autoload
  283. (defun w3-parse-hotlist (&optional fname)
  284.   "Read in the hotlist specified by FNAME"
  285.   (if (not fname) (setq fname w3-hotlist-file))
  286.   (setq w3-hotlist nil)
  287.   (if (not (file-exists-p fname))
  288.       (message "%s does not exist!" fname)
  289.     (let* ((old-buffer (current-buffer))
  290.        (buffer (get-buffer-create " *HOTW3*"))
  291.        (case-fold-search t))
  292.       (set-buffer buffer)
  293.       (erase-buffer)
  294.       (insert-file-contents fname)
  295.       (goto-char (point-min))
  296.       (cond
  297.        ((looking-at "ncsa-xmosaic-hotlist-format-1");; Old-style NCSA Mosaic
  298.     (w3-hotlist-parse-old-mosaic-format))
  299.        ((or (looking-at "<!DOCTYPE")    ; Some HTML style, including netscape
  300.         (re-search-forward "<a[ \n]+href" nil t))
  301.     (w3-read-html-bookmarks fname))
  302.        (t
  303.     (message "Cannot determine format of hotlist file: %s" fname)))
  304.       (set-buffer-modified-p nil)
  305.       (kill-buffer buffer)
  306.       (set-buffer old-buffer))))
  307.  
  308. ;;;###autoload
  309. (defun w3-use-hotlist ()
  310.   "Possibly go to a link in your W3/Mosaic hotlist.
  311. This is part of the emacs World Wide Web browser.  It will prompt for
  312. one of the items in your 'hotlist'.  A hotlist is a list of often
  313. visited or interesting items you have found on the World Wide Web."
  314.   (interactive)
  315.   (if (not w3-setup-done) (w3-do-setup))
  316.   (if (not w3-hotlist) (message "No hotlist in memory!")
  317.     (let* ((completion-ignore-case t)
  318.        (url (car (cdr (assoc
  319.                (completing-read "Goto Document: " w3-hotlist nil t)
  320.                w3-hotlist)))))
  321.       (if (string= "" url) (error "No document specified!"))
  322.       (w3-fetch url))))
  323.  
  324. ;;;###autoload
  325. (defun w3-hotlist-add-document-at-point (pref-arg)
  326.   "Add the document pointed to by the hyperlink under point to the hotlist."
  327.   (interactive "P")
  328.   (let ((url (w3-view-this-url t))
  329.     (widget (widget-at (point)))
  330.     (title nil))
  331.     (or url (error "No link under point."))
  332.     (if (and (widget-get widget :from)
  333.          (widget-get widget :to))
  334.     (setq title (buffer-substring (widget-get widget :from)
  335.                       (widget-get widget :to))))
  336.     (w3-hotlist-add-document pref-arg (or title url) url)))
  337.  
  338. ;;;###autoload
  339. (defun w3-hotlist-add-document (pref-arg &optional the-title the-url)
  340.   "Add this documents url to the hotlist"
  341.   (interactive "P")
  342.   (save-excursion
  343.     (let* ((buffer (get-buffer-create " *HOTW3*"))
  344.        (title (or the-title
  345.               (and pref-arg (read-string "Title: "))
  346.               (buffer-name)))
  347.        (make-backup-files nil)
  348.        (version-control nil)
  349.        (require-final-newline t)
  350.        (url (or the-url (url-view-url t))))
  351.       (if (rassoc (list url) w3-hotlist)
  352.       (error "That item already in hotlist, use w3-hotlist-rename-entry."))
  353.       (set-buffer buffer)
  354.       (erase-buffer)
  355.       (setq w3-hotlist (cons (list title url) w3-hotlist)
  356.         url (url-unhex-string url))
  357.       (if (not (file-exists-p w3-hotlist-file))
  358.       (progn
  359.         (message "Creating hotlist file %s" w3-hotlist-file)
  360.         (insert "ncsa-xmosaic-hotlist-format-1\nDefault\n\n")
  361.         (backward-char 1))
  362.     (progn
  363.       (insert-file-contents w3-hotlist-file)
  364.       (goto-char (point-max))
  365.       (backward-char 1)))
  366.       (insert "\n" url " " (current-time-string) "\n" title)
  367.       (write-file w3-hotlist-file)
  368.       (kill-buffer (current-buffer)))))
  369.  
  370. (provide 'w3-hot)
  371.